#!/usr/bin/perl -w

#=======================================================================
# git-update-dirs
# File ID: f1ba77e4-444e-11e0-963c-00023faf1383
# Update many git local repositories at once
#
# Character set: UTF-8
# ©opyleft 2011– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 2 or later, see end of 
# file for legal stuff.
#=======================================================================

use strict;
use Cwd qw{ abs_path getcwd };
use Getopt::Long;
use File::Basename;

$| = 1;

our $Debug = 0;

our %Opt = (

    'aggressive-compress' => 0,
    'all-options' => 0,
    'allbr' => 0,
    'compress' => 0,
    'dangling' => 0,
    'debug' => 0,
    'delete-dangling' => 0,
    'dry-run' => 0,
    'fetch' => 0,
    'fetch-prune' => 0,
    'ga-dropget' => 0,
    'ga-dropunused' => 0,
    'ga-getnew' => 0,
    'ga-moveunused' => 0,
    'ga-sync' => 0,
    'help' => 0,
    'lpar' => 0,
    'pull' => 0,
    'push' => 0,
    'quiet' => 0,
    'recursive' => 0,
    'submodule' => 0,
    'test' => 0,
    'verbose' => 0,
    'version' => 0,

);
our @opt_dirs_from = ();
our @opt_exec_after = ();
our @opt_exec_before = ();

our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = "0.00";

my $archive_disk = "seagate-3tb"; # FIXME: Hardcoding

Getopt::Long::Configure("bundling");
GetOptions(

    "aggressive-compress|C" => \$Opt{'aggressive-compress'},
    "all-options|A" => \$Opt{'all-options'},
    "allbr|a+" => \$Opt{'allbr'},
    "compress|c" => \$Opt{'compress'},
    "dangling|d" => \$Opt{'dangling'},
    "debug" => \$Opt{'debug'},
    "delete-dangling|D" => \$Opt{'delete-dangling'},
    "dirs-from=s" => \@opt_dirs_from,
    "dry-run|n" => \$Opt{'dry-run'},
    "exec-after|e=s" => \@opt_exec_after,
    "exec-before|E=s" => \@opt_exec_before,
    "fetch-prune|F" => \$Opt{'fetch-prune'},
    "fetch|f" => \$Opt{'fetch'},
    "ga-dropget|G" => \$Opt{'ga-dropget'},
    "ga-dropunused|u" => \$Opt{'ga-dropunused'},
    "ga-getnew|N" => \$Opt{'ga-getnew'},
    "ga-moveunused|U" => \$Opt{'ga-moveunused'},
    "ga-sync|g" => \$Opt{'ga-sync'},
    "help|h" => \$Opt{'help'},
    "lpar|l" => \$Opt{'lpar'},
    "pull|p" => \$Opt{'pull'},
    "push|P" => \$Opt{'push'},
    "quiet|q+" => \$Opt{'quiet'},
    "recursive|r" => \$Opt{'recursive'},
    "submodule|s" => \$Opt{'submodule'},
    "test|t" => \$Opt{'test'},
    "verbose|v+" => \$Opt{'verbose'},
    "version" => \$Opt{'version'},

) || die("$progname: Option error. Use -h for help.\n");

$Opt{'debug'} && ($Debug = 1);
$Opt{'verbose'} -= $Opt{'quiet'};
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
    print_version();
    exit(0);
}

($Opt{'ga-dropunused'} && $Opt{'ga-moveunused'}) &&
    die("$progname: Can't use -u/--ga-dropunused and -U/--ga-moveunused " .
        "at the same time\n");

if ($Opt{'all-options'}) {
    $Opt{'allbr'} = 1;
    $Opt{'dangling'} = 1;
    $Opt{'delete-dangling'} = 1;
    $Opt{'fetch-prune'} = 1;
    $Opt{'ga-sync'} = 1;
    $Opt{'lpar'} = 1;
    $Opt{'pull'} = 1;
    $Opt{'push'} = 1;
    $Opt{'submodule'} = 1;
}
($Opt{'ga-dropget'} || $Opt{'ga-dropunused'} || $Opt{'ga-moveunused'}) &&
    ($Opt{'ga-sync'} = 1);

my @Dirs = @ARGV;
my @err_compress = ();
my @err_dangling = ();
my @err_fetch = ();
my @err_gasync = ();
my @err_pull = ();
my @err_push = ();
my @err_test = ();
my @err_updsub = ();

if ($Opt{'recursive'}) {
    my $repos = `find -type d -name .git -print0`;
    $repos =~ s/\/\.git\000/\000/g;
    my %dupdir;
    @Dirs = sort(grep { !$dupdir{$_}++ } (@Dirs, split("\000", $repos)));
}

my $orig_dir = getcwd();
my ($total_before, $total_after, $total_saved) = (0, 0, 0);
my ($totnum_before, $totnum_after) = (0, 0);

for my $dirfile (@opt_dirs_from) {
    if ($dirfile eq '-') {
        while (<STDIN>) {
            chomp();
            push(@Dirs, $_);
        }
    } else {
        open(DirFP, "<$dirfile") or
            die("$progname: $dirfile: Cannot read from file: $!\n");
        while (<DirFP>) {
            chomp();
            push(@Dirs, $_);
        }
        close(DirFP);
    }
}

LOOP: for my $f (@Dirs) {
    my $object_dir = '';
    -d "$f/.git/." && ($object_dir = ".git/objects");
    -d "$f/objects/." && ($object_dir = "objects");
    msg(2, "object_dir = '$object_dir'");
    if (length($object_dir)) {
        $Opt{'verbose'} >= -1 && print("================ $f ================\n");
        if (!chdir($f)) {
            warn("$progname: $f: Cannot chdir: $!\n");
            next LOOP;
        }
        inside_git_dir() && (chdir('..'), $object_dir = ".git/objects");
        my $is_bare = (get_config('core.bare') =~ /^true/) ? 1 : 0;
        msg(2, "is_bare = '$is_bare'");

        my $Lh = "[0-9a-fA-F]";
        my $uuid_templ = "$Lh\{8}-$Lh\{4}-$Lh\{4}-$Lh\{4}-$Lh\{12}";
        my $is_annex = (get_config('annex.uuid') =~ /^$uuid_templ/) ? 1 : 0;
        msg(2, "is_annex = '$is_annex'");

        my $is_modified = 0;
        if (!$is_bare && (
                $Opt{'ga-dropget'} ||
                $Opt{'ga-dropunused'} ||
                $Opt{'ga-moveunused'} ||
                $Opt{'ga-sync'}
            )
        ) {
            open(my $fh, "git status --porcelain |") or
                die("$progname: Cannot open 'git status --porcelain' pipe: $!\n");
            while (<$fh>) {
                /^\?\?/ && next;
                $is_modified = 1;
            }
            close($fh);
        }

        if ($is_modified) {
            $Opt{'ga-dropget'} = 0;
            $Opt{'ga-dropunused'} = 0;
            $Opt{'ga-moveunused'} = 0;
            $Opt{'ga-sync'} = 0;
        }

        if (should('exec-before')) {
            for my $arg (@opt_exec_before) {
                mysystem($arg);
            }
        }
        if (should('lpar')) {
            mysystem("lpar");
        }
        if (should('test')) {
            mysystem("git", "fsck") && (
                push(@err_test, $f),
                warn("$progname: $f: ERRORS FOUND! Skipping other actions for this repo.\n"),
                next LOOP
            );
        }
        if (should('fetch-prune')) {
            mysystem("git", "fetch", "--all", "--prune") && push(@err_fetch, $f);
        } elsif (should('fetch')) {
            mysystem("git", "fetch", "--all") && push(@err_fetch, $f);
        }
        if (should('pull') && !$is_bare) {
            mysystem("git", "pull", "--ff-only") && push(@err_pull, $f);
            if (-e '.emptydirs') {
                mysystem('git', 'restore-dirs');
            }
        }
        if ($is_annex && (should('ga-sync') || should('ga-getnew'))) {
            should('ga-sync') && mysystem("ga", "sync") && push(@err_gasync, $f);
            if (should('ga-dropget')) {
                mysystem("ga", "drop", "--auto");
                mysystem("ga", "sync");
            }
            if (should('ga-dropunused')) {
                mysystem("ga", "unused");
                mysystem("ga", "dropunused", "all");
                mysystem("ga", "sync");
            }
            if (should('ga-moveunused')) {
                if (open(my $fh, "git remote |")) {
                    my $found = 0;
                    while (my $curr_remote = <$fh>) {
                        if ($curr_remote =~ /^$archive_disk$/) {
                            mysystem("ga", "unused");
                            mysystem("ga", "move", "--unused", "--to", $archive_disk);
                            mysystem("ga", "sync");
                            last;
                        }
                    }
                    close($fh);
                } else {
                    warn("$progname: Cannot open 'git remote' pipe: $!\n");
                }
            }
            if (should('ga-dropget') || should('ga-getnew')) {
                if (!$Opt{'ga-getnew'}) {
                    mysystem("ga", "get", "--auto");
                    mysystem("ga", "sync");
                } else {
                    mysystem("ga-getnew | fold-stdout");
                }
            }
        }
        if (should('dangling')) {
            mysystem("git", "dangling") && push(@err_dangling, $f);
        }
        if (should('allbr')) {
                $is_bare || mysystem("git", "nobr");
                ($is_bare || $Opt{'allbr'} > 1) && mysystem("git", "allbr", "-a");
                $is_bare || mysystem("git", "checkout", "-");
        }
        if (should('push')) {
            mysystem("git", "pa") && push(@err_push, $f);
        }
        if (should('submodule') && -e ".gitmodules") {
            mysystem("git", "submodule", "init");
            mysystem("git", "submodule", "update") && push(@err_updsub, $f);
        }
        if (should('compress') || should('aggressive-compress')) {
            chomp(my $before = `(find $object_dir -type f -printf '%s+' ; echo 0) | bc`);
            $total_before += $before;
            chomp(my $numfiles_before = `find $object_dir -type f | wc -l`);
            $totnum_before += $numfiles_before;
            if (should('aggressive-compress')) {
                mysystem("git gc --aggressive") && push(@err_compress, $f);
            } else {
                mysystem("git gc") && push(@err_compress, $f);
            }
            chomp(my $after = `(find $object_dir -type f -printf '%s+' ; echo 0) | bc`);
            $total_after += $after;
            my $saved = $before - $after;
            chomp(my $numfiles_after = `find $object_dir -type f | wc -l`);
            $totnum_after += $numfiles_after;
            $before && printf("\nBefore: %s\nAfter : %s\nSaved : %s (%.4f%%)\n", commify($before), commify($after), commify($saved), 100.0 * $saved / $before);
            printf("Number of files in %s: before: %u, after: %u, saved: %d\n",
                $object_dir, $numfiles_before, $numfiles_after, $numfiles_before-$numfiles_after)
            # Temporarily (?) disabled, it takes a heck of a long 
            # time and uses loads of CPU and memory. If the 
            # git-annex repo gets corrupted it's in most cases good 
            # enough to delete .git/annex/index anyway, and that can 
            # be done manually.
            # $is_annex && should('dangling') && mysystem("ga", "repair");
        }
        if (should('delete-dangling') && !$is_bare) {
            mysystem("git", "dangling", "-D");
        }
        if (should('lpar')) {
            mysystem("lpar");
        }
        if (should('exec-after')) {
            for my $arg (@opt_exec_after) {
                mysystem($arg);
            }
        }
        $Opt{'verbose'} >= -1 && print("\n");
    }
    chdir($orig_dir) || die("$progname: $orig_dir: Cannot return to original directory: $!\n");
}
scalar(@err_fetch) && print("$progname: Unable to fetch from: " . join(" ", @err_fetch) . "\n");
scalar(@err_gasync) && print("$progname: Unable to run ga sync: " . join(" ", @err_gasync) . "\n");
scalar(@err_dangling) && print("$progname: Unable to run git dangling: " . join(" ", @err_dangling) . "\n");
scalar(@err_pull) && print("$progname: Unable to pull from: " . join(" ", @err_pull) . "\n");
scalar(@err_push) && print("$progname: Unable to push from: " . join(" ", @err_push) . "\n");
scalar(@err_updsub) && print("$progname: Unable to update submodules in: " . join(" ", @err_updsub) . "\n");
scalar(@err_compress) && print("$progname: Unable to compress: " . join(" ", @err_compress) . "\n");
scalar(@err_test) && print("$progname: Error in git fsck: " . join(" ", @err_test) . "\n");

if ($Opt{'compress'} || $Opt{'aggressive-compress'}) {
    my $total_saved = $total_before - $total_after;
    printf("Before: %s\nAfter : %s\n", commify($total_before), commify($total_after));
    $total_before && printf("Total : %s (%.4f%%)\n",
        commify($total_saved), 100.0 * $total_saved / $total_before);
    printf("Number of object files: before: %u, after: %u, saved: %d\n",
        $totnum_before, $totnum_after, $totnum_before-$totnum_after)
}

sub check_sig {
    # {{{
    my $retval = shift;
    ($retval & 127) && die("\n$progname: Child process interrupted, aborting.\n");
    return(0);
    # }}}
} # check_sig()

sub commify {
	# {{{
	my $Str = reverse $_[0];
	$Str =~ s/(\d\d\d)(?=\d)(?!\d*\,)/$1,/g;
	return scalar reverse $Str;
	# }}}
} # commify()

sub get_config {
    # {{{
    my $name = shift;
    my $retval = '';
    chomp($retval = `git config --get "$name"`);
    return($retval);
    # }}}
} # get_config()

sub inside_git_dir {
    # {{{
    my $basename = basename(abs_path(getcwd()));
    my $retval = ($basename eq '.git') ? 1 : 0;
    return($retval);
    # }}}
} # inside_git_dir()

sub mysystem {
    # {{{
    my @cmd = @_;
    msg(0, sprintf("%s '", $Opt{'dry-run'} ? "Simulating" : "Executing") .
        join(" ", @cmd) . "'...");
    $? = 0;
    !$Opt{'dry-run'} && system(@cmd) && check_sig($?);
    return $?;
    # }}}
} # mysystem()

sub print_version {
    # Print program version {{{
    print("$progname v$VERSION\n");
    # }}}
} # print_version()

sub should {
    # {{{
    my $name = shift;
    get_config("git-update-dirs.no-$name") eq 'true' && return 0;
    my $retval = 0;
    if ($name =~ /^exec-(before|after)$/) {
        scalar($1 eq "before" ? @opt_exec_before : @opt_exec_after) && ($retval = 1);
    } else {
        $Opt{$name} && ($retval = 1);
    }
    return($retval);
    # }}}
} # should()

sub usage {
    # Send the help message to stdout {{{
    my $Retval = shift;

    if ($Opt{'verbose'}) {
        print("\n");
        print_version();
    }
    print(<<END);

Usage: $progname [options] [directories [...]]

Options:

  -E X, --exec-before X
    Execute command X in every repo before all other commands. This 
    option can be specified multiple times to run several commands.
    To disable: git config git-update-dirs.no-exec-before true
  -l, --lpar
    Execute lpar before and after fetch/pull and push
    To disable: git config git-update-dirs.no-lpar true
  -t, --test
    Test integrity of local repositories by running "git fsck".
    To disable: git config git-update-dirs.no-test true
  -F, --fetch-prune
    Fetch new commits from all remotes and prune deleted remote 
    branches.
    To disable: git config git-update-dirs.no-fetch-prune true
  -f, --fetch
    Fetch new commits from all remotes.
    To disable: git config git-update-dirs.no-fetch true
  -p, --pull
    Also execute "git pull --ff-only".
    To disable: git config git-update-dirs.no-pull true
  -g, --ga-sync
    If the repo is used by git-annex, run "ga sync".
    To disable: git config git-update-dirs.no-ga-sync true
  -G, --ga-dropget
    Drop annex files having more copies than necessary, get files with 
    fewer copies than necessary.
    To disable: git config git-update-dirs.no-ga-dropget true
  -u, --ga-dropunused
    In a git-annex repo, run "ga unused" followed by "ga dropunused 
    all". Can't be used together with -U/--ga-moveunused.
    To disable: git config git-update-dirs.no-ga-dropunused true
  -U, --ga-moveunused
    Move unused git-annex contents to the '$archive_disk' remote. Can't 
    be used together with -u/--ga-dropunused.
    To disable: git config git-update-dirs.no-ga-moveunused true
  -N, --ga-getnew
    Execute "ga-getnew | fold-stdout", i.e. use "ga get --auto" to get 
    all files from one week back that don't have enough copies.
    To disable: git config git-update-dirs.no-ga-getnew true
  -d, --dangling
    Execute "git dangling", i.e. turn all dangling commits into 
    branches.
    To disable: git config git-update-dirs.no-dangling true
  -a, --allbr
    Execute "git nobr", "git allbr -a" and "git commit -". If this 
    option is specified once, it's only executed in bare repos. To also 
    execute it in non-bare repos, it must be specified twice.
    To disable: git config git-update-dirs.no-allbr true
  -P, --push
    Also execute "git pa".
    To disable: git config git-update-dirs.no-push true
  -s, --submodule
    Update submodules if .gitmodules is found.
    To disable: git config git-update-dirs.no-submodule true
  -c, --compress
    Compress local repositories to save space.
    To disable: git config git-update-dirs.no-compress true
  -C, --aggressive-compress
    Use --aggressive when compressing the repository.
    To disable: git config git-update-dirs.no-aggressive-compress true
  -D, --delete-dangling
    Execute "git dangling -D" after execution to remove local commit-* 
    branches and tag-* tags. This option is ignored in bare repos.
    To disable: git config git-update-dirs.no-delete-dangling true
  -e X, --exec-after X
    Execute command X in every repo after all other commands. This 
    option can be specified multiple times to run several commands.
    To disable: git config git-update-dirs.no-exec-after true

  -A, --all-options
    Run the program as if "-lFpgdaPsD" had been specified.
  --dirs-from X
    Read directory list from file X. If "-" is specified, read from 
    stdin. Can be specified multiple times to read from different files.
  -h, --help
    Show this help.
  -n, --dry-run
    Simulate, don't actually execute any git commands.
  -q, --quiet
    Be less verbose. Can be repeated.
  -r, --recursive
    Update all repositories recursively under the current directory.
  -v, --verbose
    Increase level of verbosity. Can be repeated.
  --version
    Print version information.
  --debug
    Print debugging messages.

To disable some of these commands in a specific repository, set the git 
config variable git-update-dirs.no-OPTION to "true". For example, to 
disable push:

  git config git-update-dirs.no-push true

Or disable aggressive compression:

  git config git-update-dirs.no-aggressive-compress true

In this case aggressive compression will be disabled, and it will fall 
back to regular compression.

Only the value "true" (with lower case letters) is recognised, any other 
value will allow the command to run.

END
    exit($Retval);
    # }}}
} # usage()

sub msg {
    # Print a status message to stderr based on verbosity level {{{
    my ($verbose_level, $Txt) = @_;

    if ($Opt{'verbose'} >= $verbose_level) {
        print(STDERR "$progname: $Txt\n");
    }
    # }}}
} # msg()

sub D {
    # Print a debugging message {{{
    $Debug || return;
    my @call_info = caller;
    chomp(my $Txt = shift);
    my $File = $call_info[1];
    $File =~ s#\\#/#g;
    $File =~ s#^.*/(.*?)$#$1#;
    print(STDERR "$File:$call_info[2] $$ $Txt\n");
    return("");
    # }}}
} # D()

__END__

# Plain Old Documentation (POD) {{{

=pod

=head1 NAME



=head1 SYNOPSIS

 [options] [file [files [...]]]

=head1 DESCRIPTION



=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print a brief help summary.

=item B<-v>, B<--verbose>

Increase level of verbosity. Can be repeated.

=item B<--version>

Print version information.

=item B<--debug>

Print debugging messages.

=back

=head1 BUGS



=head1 AUTHOR

Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.

=head1 COPYRIGHT

Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
This is free software; see the file F<COPYING> for legalese stuff.

=head1 LICENCE

This program is free software: you can redistribute it and/or modify it 
under the terms of the GNU General Public License as published by the 
Free Software Foundation, either version 2 of the License, or (at your 
option) any later version.

This program is distributed in the hope that it will be useful, but 
WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along 
with this program.
If not, see L<http://www.gnu.org/licenses/>.

=head1 SEE ALSO

=cut

# }}}

# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
